Hottest 6/Hottest 6 (1996)(PDSoft)[!].iso/software/fredfish/1059.lha/Programs/MathPlot/Macros/Grid.mapl

Text File | 1994-12-15 | 5KB | 271 lines

/* Plots a grid. */
/* Version 1.50, 07.08.1993 */

options results


IF ~SHOW('L','rexxmathlib.library') THEN
   CALL ADDLIB('rexxmathlib.library',0,-30)

/* First, get some infos from the program */

getintervall2 stem intervall.
evalstring intervall.xmin
xmn = result
evalstring intervall.xmax
xmp = result
evalstring intervall.ymin
ymn = result
evalstring intervall.ymax
ymp = result

xmodem = 1
ymodem = 1
if(intervall.xmode = 1) then xmodem = 2.718281828
if(intervall.ymode = 1) then ymodem = 2.718281828
if(intervall.xmode = 2) then xmodem = 3.141592654
if(intervall.ymode = 2) then ymodem = 3.141592654

/* Calc dx and dy */
dx = (xmp-xmn)/200
dy = (ymp-ymn)/200

info stem b.
resx   = b.resx
resy   = b.resy
colors = b.colors

xm = (resx-1)/(xmp-xmn)
ym = (resy-1)/(ymp-ymn)

/* Calc the tics */
xtics = maketics(xmn, xmp, 0, 10)
ytics = maketics(ymn, ymp, 0, 10)

flx = floor(xmn/xtics)
fly = floor(ymn/ytics)
clx = ceil(xmp/xtics)
cly = ceil(ymp/ytics)

/* Draw the tics */
drawtics(xtics*flx, xtics, xtics*clx,
        ,ytics*fly, ytics, ytics*cly,
        ,xm,ym)
exit

/* ------------------------------------------------------------*/
/* Function MakeTics */
maketics:
parse arg tmin, tmax, logscale, baselog

x = tmin-tmax

xr  = fabs(x)
l10 = log10(xr)
if(l10 >= 0.0) then do
 i = floor(l10)
 end
else do
 i = ceil(l10-1.0)
end

if(logscale) then do
  tic = raise(baselog, i)
 if(tic < 1.0) then tic = 1.0
end
else do
 xnorm = pow(10.0, l10-i)
 if(xnorm <= 2.01) then do
  tics = 0.2
  end
 else do
  if(xnorm <= 5) then do
   tics = 0.5
   end
  else do
   tics = 1.0
  end
 end
  tic = tics * raise(10.0,i)
end
return tic


/* ------------------------------------------------------------*/
/* Function RAISE */
raise:
parse arg x,y

val = 1.0
do i=0 to abs(y)-1
 val = val*x
end

if(y < 0) then val = 1/val

return val


/* ------------------------------------------------------------*/
/* DrawTics */
drawtics:
parse arg xstart, xdiff, xendorig, ystart, ydiff, yendorig, xm, ym


/* Round a bit */
xend = xendorig * 1.001
yend = yendorig * 1.001

a = 0
b = 0

e    = exp(1)
pi   = 2*acos(0)
ln10 = ln(10)


select
 when intervall.xmode=0 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1
   xmd.a = x.a-dx
   xpd.a = x.a+dx
   a   = a+1
  end
 end
 when intervall.xmode=1 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1*e
   xmd.a = x.a-dx*e
   xpd.a = x.a+dx*e
   a   = a+1
  end
 end
 when intervall.xmode=2 then do
  do pos1 = xstart to xend by xdiff
   x.a   = pos1*pi
   xmd.a = x.a-dx*pi
   xpd.a = x.a+dx*pi
   a   = a+1
  end
 end
 when intervall.xmode=3 then do
  do pos1 = xstart to xend by xdiff
   x.a   = exp(pos1)
   xmd.a = exp(pos1-dx)
   xpd.a = exp(pos1+dx)
   a   = a+1
  end
 end
 when intervall.xmode=4 then do
  do pos1 = xstart to xend by xdiff
   x.a   = exp(pos1*ln10)
   xmd.a = exp((pos1-dx)*ln10)
   xpd.a = exp((pos1+dx)*ln10)
   a   = a+1
  end
 end
 otherwise nop
end


select
 when intervall.ymode=0 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1
   ymd.b = y.b-dy
   ypd.b = y.b+dy
   b   = b+1
  end
 end
 when intervall.ymode=1 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1*e
   ymd.b = y.b-dy*e
   ypd.b = y.b+dy*e
   b   = b+1
  end
 end
 when intervall.ymode=2 then do
  do pos1 = ystart to yend by ydiff
   y.b   = pos1*pi
   ymd.b = y.b-dy*pi
   ypd.b = y.b+dy*pi
   b   = b+1
  end
 end
 when intervall.ymode=3 then do
  do pos1 = ystart to yend by ydiff
   y.b   = exp(pos1)
   ymd.b = exp(pos1-dy)
   ypd.b = exp(pos1+dy)
   b   = b+1
  end
 end
 when intervall.ymode=4 then do
  do pos1 = ystart to yend by ydiff
   y.b   = exp(pos1*ln10)
   ymd.b = exp((pos1-dy)*ln10)
   ypd.b = exp((pos1+dy)*ln10)
   b   = b+1
  end
 end
 otherwise nop
end


minx = (xmp-xmn)*xmodem/1000
miny = (ymp-ymn)*ymodem/1000


/* Reset plotcolor */
getcolor plotcolor
oldcolor = result

/* Ask plotcolor */
/* First generate the button-string */
select
 when colors = 2 then do
  but = "1|Cancel"
 end
 when colors = 4 then do
  but = "1|2|3|Cancel"
 end
 when colors = 8 then do
  but = "1|2|3|4|5|6|7|Cancel"
 end
 when colors = 16 then do
  but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
 end
 when colors = 32 then do
  /* 32 colors does not make sense here */
  but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
 end
end

text = 'title "GridLines" prompt "Select a color" button ' || but

/* Now ask */
requestresponse text

if RC == 5 then exit

setcolor plotcolor result


/* Plot a cross, but only if NOT on an axis */
do i=0 to a-1
 do j=0 to b-1
  if (abs(x.i) > minx) then do
   if(abs(y.j) > miny) then do
    line xmd.i  y.j    xpd.i  y.j
    line x.i    ymd.j  x.i    ypd.j
   end
  end
 end
end

setcolor plotcolor oldcolor

return 0